PC-Blue - MS DOS Public Domain Library/PC-Blue MS-DOS Public Domain Library - NYACC.iso/vol354/manage.arc/ADDB.PRG

Text File | 1987-08-16 | 20.9 KB | 717 lines

**    Last revision: May 27, 1986 at 19:09
* addb.prg
STOR 'A' TO choice
CLEA
TEXT

    Welcome to the 'ADD' Menu.  We can now add new buildings to the
    data file - or add new tenants to existing buildings already in
    the data base.

    Note that when you add a building, you will be given the option
    of adding the tenants or the units at the same time.

          <A> add a new building
          <B> add tenants to a building already in the data base
          <C> return to main menu without adding











ENDT
@ 13,10 SAY 'How shall we proceed ? '
@ 13,42 GET choice picture '!'
READ
DO WHIL AT(choice, 'ABC') = 0
 @ 13,42 GET choice PICTURE '!'
 READ
 CLEA GETS
ENDD while AT(choice)
DO CASE
CASE choice = 'A'
* this program will add records to the current files
 STOR .t. TO first
 STOR .t. TO more
 SET INTENSITY ON
 SET DELIMITER OFF
 DO WHIL more
* set up screen for data entry
  IF first
   DO b_first
   STOR .f. TO first
  ENDI
  STOR 'Add Building Records' TO mode
  STOR 'First enter data about the building. You then will be able to' TO prompt1
  STOR 'enter tenant data before you enter another building.' TO prompt2
  STOR "To terminate session leave building blank and hit control 'Q'or 'W'" TO prompt3
* get a set of default memory variables for data entry
  STOR SPACE(50) TO blnks
  STOR SUBSTR(blnks,1,35) TO mbaddr
  STOR SUBSTR(blnks,1,2) TO mbcode
  STOR SUBSTR(blnks,1,20) TO mbcity
  STOR SUBSTR(blnks,1,2) TO mbst
  STOR SUBSTR(blnks,1,5) TO mbzip
  STOR SUBSTR(blnks,1,25) TO mbmgr
  STOR SUBSTR(blnks,1,13) TO mbphone
  STOR SUBSTR(blnks,1,2) TO mbtype
  STOR SUBSTR(blnks,1,3) TO mbunit
  STOR SUBSTR(blnks,1,8) TO mbacq
  STOR 0 TO mbprice
  STOR SUBSTR(blnks,1,35) TO mremit
  STOR SUBSTR(blnks,1,13) TO mphone
  STOR SUBSTR(blnks,1,35) TO mremitad
  STOR SUBSTR(blnks,1,35) TO mremitc
  STOR SUBSTR(blnks,1,50) TO mchecks
  STOR SUBSTR(blnks,1,50) TO mbnotes
  STOR DTOC(date()) TO mbupdate
* let user enter data
  @ 1,26 SAY mode
  @ 3,10 GET mbaddr
  @ 3,61 GET mbcode PICTURE '99'
  @ 4,10 GET mbcity
  @ 4,44 GET mbst PICTURE '!!'
  @ 4,61 GET mbzip PICTURE '99999'
  @ 6,10 GET mbmgr
  @ 6,61 GET mbphone PICTURE '[phone]'
  @ 7,10 GET mbtype
  @ 7,61 GET mbunit
  @ 9,10 GET mbacq PICTURE '99/99/99'
  @ 9,61 GET mbprice
  @ 12,10 GET mremit
  @ 12,61 GET mphone PICTURE '[phone]'
  @ 13,10 GET mremitad
  @ 14,10 GET mremitc
  @ 15,10 GET mchecks
  @ 17,10 GET mbnotes
  @ 18,61 GET mbupdate PICTURE '99/99/99'
  @ 20, 4 SAY prompt1
  @ 21, 4 SAY prompt2
  @ 22, 4 SAY prompt3
  READ
  CLEA GETS
* if a building was entered
* add a new record with the entered data
  IF mbaddr <> ' '
* validation
* this module validates added records
* test if there is a bad field validation
   DO CASE
   CASE mbcode = ' '
* no building code
    STOR .t. TO error
   OTHE
    STOR .f. TO error
   ENDC
* if test for error was true then fix the fields that need fixing
   IF error
* erase the lines to be used for prompts
    @ 01,00
    @ 20,00
    @ 21,00
    @ 22,00
* tell them to correct it
    @ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
    STOR .t. to an_error
    DO WHIL an_error
     DO CASE
     CASE mbcode = ' '
      @ 20,15 SAY 'Must have a building code                              '
      @ 03,61 GET mbcode PICTURE '99'
      READ
     OTHE
      STOR .f. TO an_error
     ENDC
    ENDD while an:error
   ENDI error
   * RELE error, an_error
   SET DELIMITER ON
   SET INTENSITY OFF
   STOR 'N' TO command
   @ 20,01 SAY SPACE(75)
   @ 21,01 SAY SPACE(75)
   @ 22,01 SAY SPACE(75)
   @ 20,15 SAY 'Are there any more changes ?                        '
   @ 20,48 GET command picture '!'
   READ
   SET DELIMITER OFF
   SET INTENSITY ON
   IF command = 'Y'
    @ 1,00
    @ 1,26 SAY mode
    @ 3,10 GET mbaddr
    @ 3,61 GET mbcode PICTURE '99'
    @ 4,10 GET mbcity
    @ 4,44 GET mbst PICTURE '!!'
    @ 4,61 GET mbzip PICTURE '99999'
    @ 6,10 GET mbmgr
    @ 6,61 GET mbphone PICTURE '[phone]'
    @ 7,10 GET mbtype
    @ 7,61 GET mbunit
    @ 9,10 GET mbacq PICTURE '99/99/99'
    @ 9,61 GET mbprice
    @ 12,10 GET mremit
    @ 12,61 GET mphone PICTURE '[phone]'
    @ 13,10 GET mremitad
    @ 14,10 GET mremitc
    @ 15,10 GET mchecks
    @ 17,10 GET mbnotes
    @ 18,61 GET mbupdate PICTURE '99/99/99'
    @ 20,01 SAY SPACE(75)
    @ 21,01 SAY SPACE(75)
    @ 22,01 SAY SPACE(75)
    @ 20,04 SAY prompt1
    @ 21,04 SAY prompt2
    @ 22,04 SAY prompt3
    READ
    CLEA GETS
   ENDI command = 'Y'
* add new record
   APPE BLANK
   REPL baddr WITH mbaddr, bcode WITH mbcode
   REPL bcity WITH mbcity+mbst+mbzip
   REPL bdata WITH mbmgr+mbphone+mbtype+mbunit+mbacq
   REPL bprice WITH mbprice, remit WITH mremit, phone WITH mphone
   REPL remitad WITH mremitad, remitc WITH mremitc
   REPL checks WITH mchecks, bnotes with mbnotes, bupdate WITH mbupdate
   * RELE mbcity, mbst, mbzip, mbmgr, mbphone, mbtype, mbunit, mbacq
   * RELE mbprice, mremit, mphone, mremitad, mremitc
   * RELE mchecks, mbnotes, mode, prompt1, prompt2, prompt3
   SELE B
   USE &dr.:tenant
   SET INDEX TO &dr.:codea
   STOR .t. TO more1
   STOR .t. TO first
   CLEA
   DO WHIL more1
    IF first
     DO t_first
     STOR .f. TO first
    ENDI
    STOR 'Add Tenant Records' TO mode
    STOR 'Enter as many tenants as you want. When done, enter a blank for tenant' TO prompt1
    STOR "name and unit or control 'Q' or 'W' to end session." TO prompt2
    STOR SUBSTR(blnks,1,35) TO mtenant
    STOR SUBSTR(blnks,1,3) TO mtcode
    STOR SUBSTR(blnks,1,5) to mtunit
    STOR 'R' TO mttype
    STOR SUBSTR(blnks,1,25) TO mtcontac
    STOR SUBSTR(blnks,1,13) TO mtphone
    STOR 'N' TO malt
    STOR SUBSTR(blnks,1,35) TO maltad
    STOR SUBSTR(blnks,1,35) TO maltcty
    STOR SUBSTR(blnks,1,8) TO mtexpir
    STOR SUBSTR(blnks,1,8) TO mtfirst
    STOR 0 TO mtsec
    STOR SUBSTR(blnks,1,4) TO mtsecb
    STOR SUBSTR(blnks,1,2) TO mtlate
    STOR 0 TO mtrent
    STOR 0.0000 TO mtrentpc
    STOR 0 TO mtrenpcr
    STOR 0 TO mtlatec
    STOR 0 TO mtaddl
    STOR 0 TO mtrente
    STOR 0 TO mtrentm
    STOR 0 TO mtrentd
    STOR SUBSTR(blnks,1,8) TO mtrentpd
    STOR 0 TO mtrentp
    STOR 0 TO mtrenty
    STOR 0 TO mtrentt
    STOR SUBSTR(blnks,1,8) TO mtflag
    STOR SUBSTR(blnks,1,35) TO mtnotes
    STOR mbupdate TO mtupdate
* setup gets to read data
    @ 1,26 SAY mode
    @ 3,10 GET mtenant
    @ 3,62 SAY mbcode
    @ 3,64 GET mtcode PICTURE '999'
    @ 4,10 GET mtunit
    @ 4,36 SAY mbaddr
    @ 5,10 GET mtcontac
    @ 5,62 GET mtphone PICTURE '[phone]'
    @ 6,36 GET malt PICTURE '!'
    @ 7,10 GET maltad
    @ 8,10 GET maltcty
    @ 10,10 GET mttype PICTURE '!'
    @ 10,36 GET mtrentpc
    @ 10,62 GET mtfirst PICTURE '99/99/99'
    @ 11,10 GET mtrenpcr
    @ 11,62 GET mtexpir PICTURE '99/99/99'
    @ 12,10 GET mtsec
    @ 12,36 GET mtsecb
    @ 12,62 GET mtlate PICTURE '99'
    @ 13,10 GET mtrent
    @ 13,36 GET mtlatec
    @ 13,62 GET mtaddl
    @ 14,10 GET mtrente
    @ 14,36 GET mtrentm
    @ 15,10 GET mtrentd
    @ 15,36 GET mtrentp PICTURE '99/99/99'
    @ 15,62 GET mtrentp
    @ 16,10 GET mtrenty
    @ 16,36 GET mtflag PICTURE '99/99/99'
    @ 16,62 GET mtrentt
    @ 18,10 GET mtnotes
    @ 18,61 GET mtupdate PICTURE '99/99/99'
    @ 20,01 SAY SPACE(75)
    @ 21,01 SAY SPACE(75)
    @ 22,01 SAY SPACE(75)
    @ 20, 7 SAY prompt1
    @ 21, 7 SAY prompt2
    READ
    CLEA GETS
* test if there is a bad field validation
    IF mtenant <> ' '
* validation
     DO CASE
     CASE mtcode = ' '
      STOR .t. TO error
     CASE .NOT.(malt = 'Y' .OR. malt = 'N')
      STOR .t. TO error
     CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
      STOR .t. TO error
     CASE (mttype = 'P'.OR. mttype = 'O') .AND.(.NOT.(mtrentpc >0.AND. mtrenpcr >0))
      STOR .t. TO error
     OTHE
      STOR .f. TO error
     ENDC
* if test for error was true then fix the fields that need fixing
     IF error
* erase the lines to be used for prompts
      @ 01,00
      @ 20,01 SAY SPACE(75)
      @ 21,01 SAY SPACE(75)
      @ 22,01 SAY SPACE(75)
* tell them to correct it
      @ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
      STOR .t. to an_error
      DO WHIL an_error
       DO CASE
       CASE mtcode = ' '
        @ 20,01 SAY SPACE(75)
        @ 21,01 SAY SPACE(75)
        @ 20,15 SAY 'Must have a tenant code                              '
        @ 03,61 GET mtcode PICTURE '999'
        READ
       CASE .NOT.(malt = 'Y' .OR. malt = 'N')
        @ 20,01 SAY SPACE(75)
        @ 20,15 SAY "Must answer 'Y' or 'N' to alternate address"
        @ 06,36 GET malt PICTURE '!'
        READ
       CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
        @ 20,01 SAY SPACE(75)
        @ 21,01 SAY SPACE(75)
        @ 20,05 SAY "Type must be 'R' for Regular, 'P' for Percentage which uses the higher of"
        @ 21,05 SAY "the percentage or the base rent or 'O' for Overage plus base rent"
        @ 10,10 GET mttype PICTURE '!'
        READ
       CASE (mttype = 'P'.OR. mttype = 'O').AND.(.NOT.(mtrentpc>0.AND. mtrenpcr> 0))
        @ 20,01 SAY SPACE(75)
        @ 21,01 SAY SPACE(75)
        @ 20,05 SAY 'If a percentage or overage lease, you must state the percentage'
        @ 21,05 SAY 'AND the base for calculating the percentage rent'
        @ 10,36 GET mtrentpc
        @ 11,10 GET mtrenpcr
        READ
       OTHE
        STOR .f. TO an_error
       ENDC
      ENDD while an:error
     ENDI error
* give them another chance
     SET DELIMITER ON
     SET INTENSITY OFF
     STOR 'N' TO command
     @ 20,01 SAY SPACE(75)
     @ 21,01 SAY SPACE(75)
     @ 22,01 SAY SPACE(75)
     @ 20,23 SAY 'Are there any more changes ?  '
     @ 20,50 GET command picture '!'
     READ
     SET INTENSITY ON
     SET DELIMITER OFF
     IF command = 'Y'
      @ 1,00
      @ 1,26 SAY mode
      @ 3,10 GET mtenant
      @ 3,62 SAY mbcode
      @ 3,64 GET mtcode PICTURE '999'
      @ 4,10 GET mtunit
      @ 4,36 SAY mbaddr
      @ 5,10 GET mtcontac
      @ 5,62 GET mtphone PICTURE '[phone]'
      @ 6,36 GET malt PICTURE '!'
      @ 7,10 GET maltad
      @ 8,10 GET maltcty
      @ 10,10 GET mttype PICTURE '!'
      @ 10,36 GET mtrentpc
      @ 10,62 GET mtfirst PICTURE '99/99/99'
      @ 11,10 GET mtrenpcr
      @ 11,62 GET mtexpir PICTURE '99/99/99'
      @ 12,10 GET mtsec
      @ 12,36 GET mtsecb
      @ 12,62 GET mtlate PICTURE '99'
      @ 13,10 GET mtrent
      @ 13,36 GET mtlatec
      @ 13,62 GET mtaddl
      @ 14,10 GET mtrente
      @ 14,36 GET mtrentm
      @ 15,10 GET mtrentd
      @ 15,36 GET mtrentp PICTURE '99/99/99'
      @ 15,62 GET mtrentp
      @ 16,10 GET mtrenty
      @ 16,36 GET mtflag PICTURE '99/99/99'
      @ 16,62 GET mtrentt
      @ 18,10 GET mtnotes
      @ 18,61 GET mtupdate PICTURE '99/99/99'
      @ 20,01 SAY SPACE(75)
      @ 21,01 SAY SPACE(75)
      @ 22,01 SAY SPACE(75)
      @ 20, 7 SAY prompt1
      @ 21, 7 SAY prompt2
* let user enter data
      READ
      CLEA GETS
     ENDI command = 'Y'
* put data in file
     APPE BLANK
     STOR mbcode + mtcode TO mbcod1
     REPL tenant WITH mtenant, bcode WITH mbcod1, tunit WITH mtunit
     REPL baddr WITH mbaddr, tcontac WITH mtcontac, tphone WITH mtphone
     REPL alt WITH malt, altad WITH maltad, altcty WITH maltcty
     REPL ttype WITH mttype, texpir WITH mtexpir
     REPL trentpc WITH mtrentpc, trentpcr WITH mtrenpcr
     REPL tfirst WITH mtfirst, tsec WITH mtsec, tsecb WITH mtsecb
     REPL tlate WITH mtlate, trent WITH mtrent, tlatec WITH mtlatec
     REPL taddl WITH mtaddl, trente WITH mtrente, trentm WITH mtrentm
     REPL trentd WITH mtrentd, trentpd WITH mtrentpd, trentp WITH mtrentp
     REPL trenty WITH mtrenty, trentt WITH mtrentt, tflag WITH mtflag
     REPL tnotes WITH mtnotes,tupdate WITH mtupdate
     STOR .t. TO more1
    ELSE
* get ready to stop the loop
     STOR .f. TO more1
    ENDI mtenant <> ' '
   ENDD WHILE more1
   SET DELIMITER ON
   SET INTENSITY OFF
   SELE A
   USE &dr.:build INDEX &dr.:code
   STOR 'N' TO command
   CLEA
   @ 12,14 SAY "Do you want to add another building (Y/N) ? "
   @ 12,59 GET command PICTURE '!'
   READ
   CLEA GETS
   DO WHIL AT(command, 'YN') = 0
    @ 12,59 GET command PICTURE '!'
    READ
    CLEA GETS
   ENDD
   DO CASE
   CASE command = 'N'
    STOR .f. TO more
   CASE command  = 'Y'
    STOR .t. TO more
    STOR .t. TO first
   ENDC
  ELSE
   STOR .f. TO more
  ENDI mbaddr
 ENDD WHILE MORE
 SELE A
 USE &dr.:build
 SET INDEX TO &dr.:code
 SET INTENSITY OFF
 SET DELIMITER ON
CASE choice = 'B'
 STOR '99' TO findit
 @ 13,00
 @ 13,10 SAY 'What is the code number of the building (99 to quit) ? '
 @ 13,65 GET findit PICTURE '99'
 READ
 IF findit = '99'
  RETU
 ENDI
 SEEK findit
 DO WHIL (EOF() .OR. BOF())
  STOR '99' TO findit
  @ 13,65 GET findit PICTURE '99'
  READ
  IF findit = '99'
   RETU
  ENDI
  SEEK findit
 ENDD
* this program will add tenant records to the current files
 SET DELIMITER OFF
 SET INTENSITY ON
 STOR SPACE(50) TO blnks
* set up screen for data entry
*loop until finished adding records
 STOR baddr TO mbaddr
 STOR bcode TO mbcode
 STOR bupdate TO mbupdate
 SELE B
 USE &dr.:tenant
 SET INDEX TO &dr.:codea
 STOR .t. TO more
 STOR .t. TO first
 CLEA
 DO WHIL more
  IF first
   DO t_first
   STOR .f. TO first
  ENDI
  STOR 'Add Tenant Records' TO mode
  STOR 'Enter as many tenants as you want. When done, enter a blank for tenant' TO prompt1
  STOR "name and unit or control 'Q' or 'W' to end session." TO prompt2
  STOR SUBSTR(blnks,1,35) TO mtenant
  STOR SUBSTR(blnks,1,3) TO mtcode
  STOR SUBSTR(blnks,1,5) to mtunit
  STOR 'R' TO mttype
  STOR SUBSTR(blnks,1,25) TO mtcontac
  STOR SUBSTR(blnks,1,13) TO mtphone
  STOR 'N' TO malt
  STOR SUBSTR(blnks,1,35) TO maltad
  STOR SUBSTR(blnks,1,35) TO maltcty
  STOR SUBSTR(blnks,1,8) TO mtexpir
  STOR SUBSTR(blnks,1,8) TO mtfirst
  STOR 0 TO mtsec
  STOR SUBSTR(blnks,1,4) TO mtsecb
  STOR SUBSTR(blnks,1,2) TO mtlate
  STOR 0 TO mtrent
  STOR 0.0000 TO mtrentpc
  STOR 0 TO mtrenpcr
  STOR 0 TO mtlatec
  STOR 0 TO mtaddl
  STOR 0 TO mtrente
  STOR 0 TO mtrentm
  STOR 0 TO mtrentd
  STOR SUBSTR(blnks,1,8) TO mtrentpd
  STOR 0 TO mtrentp
  STOR 0 TO mtrenty
  STOR 0 TO mtrentt
  STOR SUBSTR(blnks,1,8) TO mtflag
  STOR SUBSTR(blnks,1,35) TO mtnotes
  STOR mbupdate TO mtupdate
* setup gets to read data
  @ 1,00
  @ 1,26 SAY mode
  @ 3,10 GET mtenant
  @ 3,62 SAY mbcode
  @ 3,61 GET mtcode PICTURE '999'
  @ 4,10 GET mtunit
  @ 4,36 SAY mbaddr
  @ 5,10 GET mtcontac
  @ 5,62 GET mtphone PICTURE '[phone]'
  @ 6,36 GET malt PICTURE '!'
  @ 7,10 GET maltad
  @ 8,10 GET maltcty
  @ 10,10 GET mttype PICTURE '!'
  @ 10,36 GET mtrentpc
  @ 10,62 GET mtfirst PICTURE '99/99/99'
  @ 11,10 GET mtrenpcr
  @ 11,62 GET mtexpir PICTURE '99/99/99'
  @ 12,10 GET mtsec
  @ 12,36 GET mtsecb
  @ 12,62 GET mtlate PICTURE '99'
  @ 13,10 GET mtrent
  @ 13,36 GET mtlatec
  @ 13,62 GET mtaddl
  @ 14,10 GET mtrente
  @ 14,36 GET mtrentm
  @ 15,10 GET mtrentd
  @ 15,36 GET mtrentp PICTURE '99/99/99'
  @ 15,62 GET mtrentp
  @ 16,10 GET mtrenty
  @ 16,36 GET mtflag PICTURE '99/99/99'
  @ 16,62 GET mtrentt
  @ 18,10 GET mtnotes
  @ 18,61 GET mtupdate PICTURE '99/99/99'
  @ 20,00
  @ 21,00
  @ 22,00
  @ 20, 7 SAY prompt1
  @ 21, 7 SAY prompt2
  READ
  CLEA GETS
* test if there is a bad field validation
  IF mtenant <> ' '
* validation
   DO CASE
   CASE mtcode = ' '
    STOR .t. TO error
   CASE .NOT.(malt = 'Y' .OR. malt = 'N')
    STOR .t. TO error
   CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
    STOR .t. TO error
   CASE (mttype = 'P'.OR. mttype = 'O') .AND.(.NOT.(mtrentpc >0.AND. mtrenpcr >0))
    STOR .t. TO error
   OTHE
    STOR .f. TO error
   ENDC
* if test for error was true then fix the fields that need fixing
   IF error
* erase the lines to be used for prompts
    @ 01,00
    @ 20,00
    @ 21,00
    @ 22,00
* tell them to correct it
    @ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
    STOR .t. to an_error
    DO WHIL an_error
     DO CASE
     CASE mtcode = ' '
      @ 20,00
      @ 20,15 SAY 'Must have a tenant code                              '
      @ 03,61 GET mtcode PICTURE '999'
      READ
     CASE .NOT.(malt = 'Y' .OR. malt = 'N')
      @ 20,00
      @ 20,15 SAY "Must answer 'Y' or 'N' to alternate address"
      @ 06,36 GET malt PICTURE '!'
      READ
     CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
      @ 20,00
      @ 21,00
      @ 20,05 SAY "Type must be 'R' for Regular, 'P' for Percentage which uses the higher of"
      @ 21,05 SAY "the percentage or the base rent or 'O' for Overage plus base rent"
      @ 10,10 GET mttype PICTURE '!'
      READ
     CASE (mttype = 'P'.OR. mttype = 'O').AND.(.NOT.(mtrentpc>0.AND. mtrenpcr> 0))
      @ 20,00
      @ 21,00
      @ 20,05 SAY 'If a percentage or overage lease, you must state the percentage'
      @ 21,05 SAY 'AND the base for calculating the percentage rent'
      @ 10,36 GET mtrentpc
      @ 11,10 GET mtrenpcr
      READ
     OTHE
      STOR .f. TO an_error
     ENDC
    ENDD while an:error
   ENDI error
* give them another chance
   SET DELIMITER ON
   SET INTENSITY OFF
   STOR 'N' TO command
   @ 20,00
   @ 21,00
   @ 22,00
   @ 20,23 SAY 'Are there any more changes ?                        '
   @ 20,50 GET command picture '!'
   READ
   SET DELIMITER OFF
   SET INTENSITY ON
   IF command = 'Y'
    @ 1,00
    @ 1,26 SAY mode
    @ 3,10 GET mtenant
    @ 3,62 SAY mbcode
    @ 3,61 GET mtcode PICTURE '999'
    @ 4,10 GET mtunit
    @ 4,36 SAY mbaddr
    @ 5,10 GET mtcontac
    @ 5,62 GET mtphone PICTURE '[phone]'
    @ 6,36 GET malt PICTURE '!'
    @ 7,10 GET maltad
    @ 8,10 GET maltcty
    @ 10,10 GET mttype PICTURE '!'
    @ 10,36 GET mtrentpc
    @ 10,62 GET mtfirst PICTURE '99/99/99'
    @ 11,10 GET mtrenpcr
    @ 11,62 GET mtexpir PICTURE '99/99/99'
    @ 12,10 GET mtsec
    @ 12,36 GET mtsecb
    @ 12,62 GET mtlate PICTURE '99'
    @ 13,10 GET mtrent
    @ 13,36 GET mtlatec
    @ 13,62 GET mtaddl
    @ 14,10 GET mtrente
    @ 14,36 GET mtrentm
    @ 15,10 GET mtrentd
    @ 15,36 GET mtrentp PICTURE '99/99/99'
    @ 15,62 GET mtrentp
    @ 16,10 GET mtrenty
    @ 16,36 GET mtflag PICTURE '99/99/99'
    @ 16,62 GET mtrentt
    @ 18,10 GET mtnotes
    @ 18,61 GET mtupdate PICTURE '99/99/99'
    @ 20,00
    @ 21,00
    @ 22,00
    @ 20, 7 SAY prompt1
    @ 21, 7 SAY prompt2
* let user enter data
    READ
    CLEA GETS
   ENDI command = 'Y'
* put data in file
   APPE BLANK
   STOR mbcode + mtcode TO mbcod1
   REPL tenant WITH mtenant, bcode WITH mbcod1, tunit WITH mtunit
   REPL baddr WITH mbaddr, tcontac WITH mtcontac, tphone WITH mtphone
   REPL alt WITH malt, altad WITH maltad, altcty WITH maltcty
   REPL ttype WITH mttype, texpir WITH mtexpir
   REPL trentpc WITH mtrentpc, trentpcr WITH mtrenpcr
   REPL tfirst WITH mtfirst, tsec WITH mtsec, tsecb WITH mtsecb
   REPL tlate WITH mtlate, trent WITH mtrent, tlatec WITH mtlatec
   REPL taddl WITH mtaddl, trente WITH mtrente, trentm WITH mtrentm
   REPL trentd WITH mtrentd, trentpd WITH mtrentpd, trentp WITH mtrentp
   REPL trenty WITH mtrenty, trentt WITH mtrentt, tflag WITH mtflag
   REPL tnotes WITH mtnotes,tupdate WITH mtupdate
   STOR .t. TO more
  ELSE
* get ready to stop the loop
   STOR .f. TO more
  ENDI mtenant <> ' '
 ENDD WHILE more
 SELE A
 USE &dr.:build
 SET index TO &dr.:code
 SET DELIMITER ON
 SET INTENSITY OFF
CASE choice = '?'
 CLEA
 TEXT


                  A D D   M E N U   H E L P   S C R E E N


      The options are rather simple.  In a normal case you would add a
      building and at the same time add all of the units. (Add them even
      if vacant - just leave the tenant name blank - so that it will
      appear on the vacancy list).

      When a unit becomes vacant - we suggest you not delete the record
      - but that you delete the name of the tenant. Note, however, the
      automatic rent posting program will post the rental to the unit -
      so you will have to make an offsetting journal entry for vacancy
      losses.  Most people do that anyway.

      However, if you want to add a tenant who was never in the data base
      you have that option on this menu.


                          Press any key to continue

 ENDT
CASE choice = 'C'
 STOR .t. TO first
 RETU
ENDC
RETU